home *** CD-ROM | disk | FTP | other *** search
- / OS/8 BOO DECODING PROGRAM
-
- / LAST EDIT: 22-OCT-1991 12:00:00 CJL
-
- / MAY BE ASSEMBLED WITH '/F' SWITCH SET.
-
- / PROGRAM TO DECODE OS/8 FILES FROM "PRINTABLE" ASCII (".BOO") FORMAT TO
- / BINARY-IMAGE FORMAT. INTERMEDIATE "ASCII" CONVERSION SHOULD BE HARMLESS AS
- / LONG AS ALL PRINTING DATA CHARACTERS ARE NOT MODIFIED.
-
- / DISTRIBUTED BY CUCCA AS "K12DEB.PAL" AS PART OF THE CUCCA KERMIT-12 PACKAGE.
-
- / WRITTEN BY:
-
- / CHARLES LASNER (CJL)
- / CLA SYSTEMS
- / 72-55 METROPOLITAN AVENUE
- / MIDDLE VILLAGE, NEW YORK 11379-2107
- / (718) 894-6499
-
- / USAGE:
-
- / THIS PROGRAM OPERATES ON "PRINTABLE" ASCII FILES WHICH HAVE BEEN CREATED BY
- / ENCODING THE CONTENTS OF ARBITRARY (BINARY) FILES. THE ENCODING FORMAT ALLOWS
- / FOR CERTAIN "WHITE SPACE" MODIFICATIONS SUCH AS LINE WIDTH REFORMATTING AS
- / LONG AS ALL PRINTING CHARACTERS ARE UNMODIFIED. EXTRANEOUS <CR>/<LF> PAIRS
- / AND ALL OTHER CONTROL CHARACTERS (<FF>, <VT>, ETC.) ARE IGNORED.
-
- / WHEN CREATING THE DESCENDANT DECODED FILE, THE USER MAY SPECIFY EITHER THE
- / IMBEDDED FILENAME OR AN ALTERNATE FILENAME ON EITHER THE DEFAULT (DSK:) DEVICE
- / OR A SPECIFIED DEVICE:
-
- / .RUN DEV DEBOO INVOKE PROGRAM.
- / *INPUT INPUT IS DECODED INTO IMBEDDED NAME ON DSK: (DEFAULT).
- / *DEV:OUTPUT.EX<INPUT INPUT IS DECODED INTO OUTPUT.EX ON DEVICE DEV:.
- / *DEV:<INPUT INPUT IS DECODED INTO IMBEDDED NAME ON DEVICE DEV:.
- / *OUTPUT.EX<INPUT$ INPUT IS DECODED INTO OUTPUT.EX ON DSK: (DEFAULT).
- / THE <ESC> CHARACTER WAS USED TO TERMINATE THE LINE
- / (THIS IS SIGNIFIED BY $). THIS CAUSES PROGRAM EXIT.
- / . PROGRAM EXITS NORMALLY.
-
- / INPUT FILE ASSUMES .BO EXTENSION; THERE IS NO ASSUMED OUTPUT EXTENSION.
-
- / PROGRAM EXIT IS THE NORMAL OS/8 METHOD OF EITHER PRESSING <^C> ON THE CONSOLE
- / KEYBOARD DURING THE COMMAND, OR ENDING THE COMMAND INPUT LINE WITH AN <ESC>
- / CHARACTER.
- / .BOO FORMAT IMPLEMENTATION DESCRIPTION.
-
- / THIS PROGRAM SUPPORTS STANDARD .BOO FORMAT ENCODED FILES AND OPTIONALLY THE
- / USE OF LENGTH CORRECTION BYTES AT THE FILE'S END TO ENSURE PROPER LENGTH. IF
- / NO LENGTH CORRECTION FIELDS ARE FOUND, IT IS ASSUMED THEY AREN'T NEEDED; IT
- / IS THE RESPONIBILITY OF THE ENCODER TO INSERT THESE FIELDS IF NECESSARY. OS/8
- / FILES PROPERLY ENCODED BY THE COMPANION ENBOO-ING PROGRAM (ENBOO AKA K12ENB)
- / WILL CONTAIN SUCH BYTES AS NECESSARY, AND WILL BE PROPERLY DECODED INTO THEIR
- / ORIGINAL FORM WITHOUT LOSS. ALL OTHER FILES WILL BE <NUL>-PADDED AS NECESSARY
- / TO ROUND-UP THE FILE SIZE TO A NUMBER OF COMPLETE OS/8 RECORDS; THEIR
- / ORIGINAL LENGTH WILL BE LOST.
-
- / **** WARNING **** USE OF ENBOO-ING PROGRAMS NOT COMPATIBLE WITH THE OPTIONAL
- / LENGTH CORRECTION SCHEME CAN PRODUCE FILES DRASTICALLY DIFFERENT FROM THE
- / ORIGINAL; AN ENTIRE OS/8 RECORD CONTAINING <NUL> CHARACTERS COULD BE APPENDED
- / TO THE END OF THE FILES. BEYOND THE WASTE OF DISK SPACE, THESE DEFECTIVE
- / FILES COULD ACTUALLY BE DANGEROUS TO USE UNDER OS/8.
-
- / ORDINARILY THESE FILES SHOULDN'T EXIST, BUT COULD BE CREATED BY METHODS SUCH
- / AS DECODING ON OTHER SYSTEMS FOLLOWED BY USE OF ENCODERS INCOMPATIBLE WITH THE
- / LENGTH CORRECTION SCHEME. THIS TENDS TO MAKE THE FILE SIZE WRONG BY ONE OR
- / TWO BYTES, WHICH WHEN DECODED HERE WILL CAUSE THE CREATION OF AN ENTIRE
- / ERRONEOUS RECORD. IT IS RECOMMENDED THAT FILES STORED ON OTHER SYSTEMS FOR
- / EVENTUALLY DELIVERY TO OS/8 SYSTEMS BE MAINTAINED IN .BOO FORMAT TO PREVENT
- / THIS FORM OF FILE CORRUPTION.
-
- / ERROR MESSAGES.
-
- / ANY MESSAGE PRINTED IS A FATAL ERROR MESSAGE. ALL MESSAGES ARE THE STANDARD
- / OS/8 "USER" ERROR MESSAGES OF THE FORM: USER ERROR X AT AAAAA WHERE X IS THE
- / ERROR NUMBER AND AAAAA IS THE PROGRAM ADDRESS WHERE THE ERROR WAS DETECTED.
- / THE FOLLOWING USER ERRORS ARE DEFINED:
-
- / ERROR NUMBER PROBABLE CAUSE
-
- / 0 TOO MANY OUTPUT FILES.
-
- / 1 NO INPUT FILE OR TOO MANY INPUT FILES.
-
- / 2 IMBEDDED OUTPUT FILENAME FORMAT ERROR.
-
- / 3 I/O ERROR WHILE LOCATING IMBEDDED OUTPUT FILENAME.
-
- / 4 ERROR WHILE FETCHING FILE HANDLER.
-
- / 5 ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE.
-
- / 6 OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE.
-
- / 7 ERROR WHILE CLOSING THE OUTPUT FILE.
-
- / 8 I/O ERROR WHILE DECODING FILE DATA OR BAD DATA.
-
- / 9 OUTPUT ERROR WHILE DECODING FILE DATA.
- / ASSEMBLY INSTRUCTIONS.
-
- / IT IS ASSUMED THE SOURCE FILE K12DEB.PAL HAS BEEN MOVED AND RENAMED TO
- / DSK:DEBOO.PA.
-
- / .PAL DEBOO<DEBOO/E/F ASSEMBLE SOURCE PROGRAM
- / .LOAD DEBOO LOAD THE BINARY FILE
- / .SAVE DEV DEBOO=0 SAVE THE CORE-IMAGE FILE
- / DEFINITIONS.
-
- CLOSE= 4 /CLOSE OUTPUT FILE
- DECODE= 5 /CALL COMMAND DECODER
- ENTER= 3 /ENTER TENTATIVE FILE
- FETCH= 1 /FETCH HANDLER
- IHNDBUF=7200 /INPUT HANDLER BUFFER
- INBUFFE=6200 /INPUT BUFFER
- INFILE= 7617 /INPUT FILE INFORMATION HERE
- INQUIRE=12 /INQUIRE ABOUT HANDLER
- NL0001= CLA IAC /LOAD AC WITH 0001
- NL0002= CLA CLL CML RTL /LOAD AC WITH 0002
- NL7776= CLA CLL CMA RAL /LOAD AC WITH 7776
- NL7777= CLA CMA /LOAD AC WITH 7777
- OHNDBUF=6600 /OUTPUT HANDLER BUFFER
- OUTBUFF=5600 /OUTPUT BUFFER
- OUTFILE=7600 /OUTPUT FILE INFORMATION HERE
- PRGFLD= 00 /PROGRAM FIELD
- RESET= 13 /RESET SYSTEM TABLES
- SBOOT= 7600 /MONITOR EXIT
- TBLFLD= 10 /COMMAND DECODER TABLE FIELD
- TERMWRD=7642 /TERMINATOR WORD
- USERROR=7 /USER SIGNALLED ERROR
- USR= 7700 /USR ENTRY POINT
- USRFLD= 10 /USR FIELD
- WRITE= 4000 /I/O WRITE BIT
- *0 /START AT THE BEGINNING
-
- *10 /DEFINE AUTO-INDEX AREA
-
- XR1, .-. /AUTO-INDEX NUMBER 1
- XR2, .-. /AUTO-INDEX NUMBER 2
-
- *20 /GET PAST AUTO-INDEX AREA
-
- BUFPTR, .-. /INPUT BUFFER POINTER
- BYTES, ZBLOCK 3 /DATA BYTES
- CHRCNT, .-. /CHARACTER COUNTER
- CMPCNT, .-. /COMPRESSION COUNTER
- DANGCNT,.-. /DANGER COUNT
- DATCNT, .-. /DATA COUNTER
- IDNUMBE,.-. /INPUT DEVICE NUMBER
- INPUT, .-. /INPUT HANDLER POINTER
- INRECOR,.-. /INPUT RECORD
- FNAME, ZBLOCK 4 /OUTPUT FILENAME
- GETBERR,.-. /ERROR ROUTINE POINTER FOR GETBYTE ROUTINE
- LATEST, .-. /LATEST OUTPUT BYTE
- ODNUMBE,.-. /OUTPUT DEVICE NUMBER
- ONAME, ZBLOCK 10 /OUTPUT NAME FIELD
- OUTPUT, .-. /OUTPUT HANDLER POINTER
- OUTRECO,.-. /OUTPUT RECORD
- PUTEMP, .-. /INPUT TEMPORARY
- PUTPTR, .-. /OUTPUT POINTER
- TEMPTR, .-. /TERMPORARY OUTPUT POINTER
- THIRD, .-. /THIRD BYTE TEMPORARY
-
- PAGE /START AT THE USUAL PLACE
-
- BEGIN, NOP /HERE IN CASE WE'RE CHAINED TO
- CLA /CLEAN UP
- START, CIF USRFLD /GOTO USR FIELD
- JMS I [USR] /CALL USR ROUTINE
- DECODE /WANT COMMAND DECODER
- "B^100+"O-300 /.BO IS DEFAULT EXTENSION
- CDF TBLFLD /GOTO TABLE FIELD
- TAD I (TERMWRD) /GET TERMINATOR WORD
- SPA CLA /SKIP IF <CR> TERMINATED THE LINE
- DCA EXITZAP /ELSE CAUSE EXIT LATER
- TAD I (OUTFILE) /GET FIRST OUTPUT FILE DEVICE WORD
- SNA /SKIP IF FIRST OUTPUT FILE PRESENT
- JMP TSTMORE /JUMP IF NOT THERE
- AND [17] /JUST DEVICE BITS
- ODNULL, DCA ODNUMBER /SAVE OUTPUT DEVICE NUMBER
- TAD I (OUTFILE+5) /GET SECOND OUTPUT FILE DEVICE WORD
- SNA /SKIP IF THERE
- TAD I (OUTFILE+12) /ELSE GET THIRD OUTPUT FILE DEVICE WORD
- SZA CLA /SKIP IF BOTH NOT PRESENT
- JMP OUTERR /ELSE COMPLAIN
- TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD
- SNA /SKIP IF PRESENT
- JMP INERR /JUMP IF NOT
- AND [17] /JUST DEVICE BITS
- DCA IDNUMBER /SAVE INPUT DEVICE NUMBER
- TAD I (INFILE+2) /GET SECOND INPUT FILE DEVICE WORD
- SZA CLA /SKIP IF ONLY ONE INPUT FILE
- JMP INERR /ELSE COMPLAIN
- TAD I (INFILE+1) /GET FIRST INPUT FILE STARTING RECORD
- DCA INRECORD /SET IT UP
- CDF PRGFLD /BACK TO OUR FIELD
- CIF USRFLD /GOTO USR FIELD
- JMS I [USR] /CALL USR ROUTINE
- RESET /RESET SYSTEM TABLES
- TAD (IHNDBUFFER+1) /GET INPUT BUFFER POINTER+TWO-PAGE BIT
- DCA IHPTR /STORE IN-LINE
- TAD IDNUMBER /GET INPUT DEVICE NUMBER
- CIF USRFLD /GOTO USR FIELD
- JMS I [USR] /CALL USR ROUTINE
- FETCH /FETCH HANDLER
- IHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT
- JMP FERROR /FETCH ERROR
- TAD IHPTR /GET RETURNED ADDRESS
- DCA INPUT /STORE AS INPUT HANDLER ADDRESS
- JMS I (GEOFILE) /GET OUTPUT FILE INFORMATION
- TAD (OHNDBUFFER+1) /GET BUFFER POINTER+TWO-PAGE BIT
- DCA OHPTR /STORE IN-LINE
- TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
- CIF USRFLD /GOTO USR FIELD
- JMS I [USR] /CALL USR ROUTINE
- FETCH /FETCH HANDLER
- OHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT
- JMP FERROR /FETCH ERROR
- TAD OHPTR /GET RETURNED ADDRESS
- DCA OUTPUT /STORE AS OUTPUT HANDLER ADDRESS
- TAD (FNAME) /POINT TO
- DCA ENTAR1 /STORED FILENAME
- DCA ENTAR2 /CLEAR SECOND ARGUMENT
- TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
- CIF USRFLD /GOTO USR FIELD
- JMS I [USR] /CALL USR ROUTINE
- ENTER /ENTER TENTATIVE FILENAME
- ENTAR1, .-. /WILL POINT TO FILENAME
- ENTAR2, .-. /WILL BE ZERO
- JMP ENTERR /ENTER ERROR
- TAD ENTAR1 /GET RETURNED FIRST RECORD
- DCA OUTRECORD /STORE IT
- TAD ENTAR2 /GET RETURNED EMPTY LENGTH
- IAC /ADD 2-1 FOR OS/278 CRAZINESS
- DCA DANGCNT /STORE AS DANGER COUNT
- JMS I (DECODIT) /GO DO THE ACTUAL DECODING
- JMP PROCERR /ERROR WHILE DECODING
- TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
- CIF USRFLD /GOTO USR FIELD
- JMS I [USR] /CALL USR ROUTINE
- CLOSE /CLOSE OUTPUT FILE
- FNAME /POINTER TO FILENAME
- OUTCNT, .-. /WILL BE ACTUAL COUNT
- JMP CLSERR /CLOSE ERROR
- EXITZAP,JMP START /**** <ESC> TERMINATION **** 0000
- JMP I (SBOOT) /EXIT TO MONITOR
- / OUTPUT FILE ERROR WHILE PROCESSING.
-
- OERROR, TAD [3] /SET INCREMENT
- SKP /DON'T USE NEXT
-
- / ERROR WHILE PROCESSING INPUT FILE.
-
- PROCERR,NL0002 /SET INCREMENT
- SKP /DON'T USE NEXT
-
- / ERROR WHILE CLOSING THE OUTPUT FILE.
-
- CLSERR, NL0001 /SET INCREMENT
- SKP /DON'T CLEAR IT
-
- / OUTPUT FILE TOO LARGE ERROR.
-
- SIZERR, CLA /CLEAN UP
- TAD [3] /SET INCREMENT
- SKP /DON'T USE NEXT
-
- / ENTER ERROR.
-
- ENTERR, NL0002 /SET INCREMENT
- SKP /DON'T USE NEXT
-
- / HANDLER FETCH ERROR.
-
- FERROR, NL0001 /SET INCREMENT
-
- / I/O ERROR WHILE PROCESSING IMBEDDED FILENAME.
-
- NIOERR, IAC /SET INCREMENT
-
- / FORMAT ERROR WHILE PROCESSING IMBEDDED FILENAME.
-
- CHARERR,IAC /SET INCREMENT
-
- / INPUT FILESPEC ERROR.
-
- INERR, IAC /SET INCREMENT
-
- / OUTPUT FILESPEC ERROR.
-
- OUTERR, DCA ERRNUMBER /STORE ERROR NUMBER
- CDF PRGFLD /ENSURE OUR FIELD
- CIF USRFLD /GOTO USR FIELD
- JMS I [USR] /CALL USR ROUTINE
- USERROR /USER ERROR
- ERRNUMB,.-. /WILL BE PASSED ERROR NUMBER
- / COMES HERE TO TEST FOR NULL LINE.
-
- TSTMORE,TAD I (OUTFILE+5) /GET SECOND OUTPUT FILE DEVICE WORD
- SNA /SKIP IF PRESENT
- TAD I (OUTFILE+12) /ELSE GET THIRD OUTPUT FILE DEVICE WORD
- SZA CLA /SKIP IF NO OUTPUT FILES
- JMP OUTERR /ELSE COMPLAIN OF SECOND/THIRD (WITHOUT FIRST) OUTPUT
- TAD I (INFILE) /GET FIRST OUTPUT FILE DEVICE WORD
- SZA CLA /SKIP IF NO INPUT FILES
- JMP ODNULL /JUMP IF INPUT WITHOUT OUTPUT
- CDF PRGFLD /BACK TO OUR FIELD
- JMP EXITZAP /MIGHT BE LAST TIME, SO GO THERE FIRST
-
- PAGE
- DECODIT,.-. /DECODING ROUTINE
- TAD (DECERR) /SETUP THE
- DCA GETBERROR /GETBYTE ERROR ROUTINE
- DCA DATCNT /CLEAR DATA COUNT
- NL7777 /SETUP FOR INITIALIZING
- JMS I (PUTBYTE) /INITIALIZE OUTPUT FILE
- LOOP, JMS GETCHR /GET A CHARACTER
- JMP ENDIT /WEREN'T ANY MORE
- TAD (-176) /COMPARE TO TILDE
- SZA CLA /SKIP IF IT MATCHES
- JMP DATPROCESS /JUMP IF NOT
- JMS GETCHR /GET A CHARACTER
- DECERR, JMP I DECODIT /WASN'T ANY
- TAD (-"0!200) /REMOVE PRINTING OFFSET
- SNA /SKIP IF SIGNIFICENT COMPRESSION
- JMP DATCORRECT /JUMP IF NOT
- CIA /INVERT FOR COUNTING
- DCA CMPCNT /SAVE COMPRESSION COUNT
- JMS DATOUT /OUTPUT DATA FIELD (IF ANY) AND CLEAR DATA COUNT
- COMPLP, JMS I (PUTBYTE) /OUTPUT A <NUL> BYTE
- ISZ CMPCNT /DONE YET?
- JMP COMPLP /NO, KEEP GOING
- JMP LOOP /YES, GO BACK FOR MORE FILE ITEMS
-
- / ZERO-LENGTH COMPRESSION (CORRECTION) FIELD FOUND.
-
- DATCORR,NL7777 /BACKUP
- TAD DATCNT /NOW HAVE CORRECTED DATA COUNT
- SPA /SKIP IF COUNT WASN'T ZERO
- JMP LOOP /IGNORE BECAUSE THERE IS NO DATA
- SNA /SKIP IF ENOUGH TO CORRECT
- JMP I DECODIT /TAKE ERROR RETURN IF NOT
- DCA DATCNT /STORE CORRECTED COUNT
- JMP LOOP /GO BACK FOR MORE FILE ITEMS
- / UN-COMPRESSED DATA FOUND.
-
- DATPROC,JMS DATOUT /OUTPUT PREVIOUS DATA FIELD (IF ANY), CLEAR DATA COUNT
- TAD PUTEMP /GET LATEST BACK
- TAD (-"0!200) /REMOVE DIGIT OFFSET
- CLL RTL /MOVE UP
- DCA BYTES /STORE IT
- JMS GETCHR /GET NEXT CHARACTER
- JMP I DECODIT /WASN'T ANY
- AND (17) /JUST LOW-ORDER BITS
- CLL RTL;RTL /MOVE UP
- DCA BYTES+1 /STORE IT
- TAD PUTEMP /GET IT AGAIN
- RTR;RTR /MOVE DOWN
- IAC /REMOVE DIGIT BIAS
- AND (3) /JUST GOOD BITS
- TAD BYTES /GET OLD BITS
- DCA BYTES /STORE COMPOSITE
- JMS GETCHR /GET NEXT CHARACTER
- JMP I DECODIT /WASN'T ANY
- TAD (-"0!200) /REMOVE DIGIT OFFSET
- RTR /MOVE DOWN
- AND (17) /ISOLATE GOOD BITS
- TAD BYTES+1 /GET OLD BITS
- DCA BYTES+1 /STORE COMPOSITE
- TAD PUTEMP /GET IT AGAIN
- AND (3) /ISOLATE GOOD BITS
- CLL RTL;RTL;RTL /MOVE UP
- DCA BYTES+2 /STORE IT
- JMS GETCHR /GET NEXT CHARACTER
- JMP I DECODIT /WASN'T ANY
- TAD (-"0!200) /REMOVE DIGIT OFFSET
- TAD BYTES+2 /GET OLD BITS
- DCA BYTES+2 /STORE COMPOSITE
- TAD (3) /SETUP THE
- DCA DATCNT /DATA COUNT
- JMP LOOP /GO GET NEXT FILE ITEM
-
- / COMES HERE AT END-OF-FILE.
-
- ENDIT, JMS DATOUT /OUTPUT ANY LEFTOVER DATA
- SKP /DON'T OUTPUT YET
- CLOSLUP,JMS I (PUTBYTE) /OUTPUT A <NUL> BYTE
- TAD PUTPTR /GET THE OUTPUT BUFFER POINTER
- TAD (-OUTBUFFER) /COMPARE TO RESET VALUE
- SZA CLA /SKIP IF IT MATCHES
- JMP CLOSLUP /ELSE KEEP GOING
- ISZ DECODIT /BUMP TO GOOD RETURN
- JMP I DECODIT /RETURN TO CALLER
- DATOUT, .-. /DATA OUTPUT ROUTINE
- TAD DATCNT /GET CURRENT DATA COUNT
- CMA /SETUP FOR COUNTING
- DCA DATCNT /STORE IT
- TAD (BYTES-1) /POINT TO
- DCA XR1 /DATA AREA
- JMP DATEST /CHECK BEFORE OUTPUTTING
-
- DATLUP, TAD I XR1 /GET A BYTE
- JMS I (PUTBYTE) /OUTPUT IT
- DATEST, ISZ DATCNT /DONE YET?
- JMP DATLUP /NO, KEEP GOING
- JMP I DATOUT /YES, RETURN TO CALLER
-
- GETCHR, .-. /GET A CHARACTER ROUTINE
- GETCAGN,CLA /GET A CHARACTER
- JMS I [GETBYTE] /GET A CHARACTER FROM FILE
- JMP I GETCHR /WASN'T ANY, TAKE IMMEDIATE RETURN
- TAD [-" !200] /COMPARE TO <SPACE>
- SPA SNA CLA /SKIP IF NOT CONTROL CHARACTER OR <SPACE>
- JMP GETCAGN /GO GET ANOTHER ONE
- TAD PUTEMP /GET GOOD CHARACTER
- ISZ GETCHR /BUMP RETURN ADDRESS
- JMP I GETCHR /RETURN TO CALLER
-
- PAGE
- PUTBYTE,.-. /OUTPUT A BYTE ROUTINE
- SPA /ARE WE INITIALIZING?
- JMP PUTINITIALIZE /YES
- AND (377) /JUST IN CASE
- DCA LATEST /SAVE LATEST CHARACTER
- TAD LATEST /GET LATEST CHARACTER
- JMP I PUTNEXT /GO WHERE YOU SHOULD GO
-
- PUTNEXT,.-. /EXIT ROUTINE
- JMP I PUTBYTE /RETURN TO MAIN CALLER
-
- PUTINIT,CLA /CLEAN UP
- TAD OUTRECORD /GET STARTING RECORD OF TENTATIVE FILE
- DCA PUTRECORD /STORE IN-LINE
- DCA I (OUTCNT) /CLEAR ACTUAL FILE LENGTH
- PUTNEWR,TAD POUTBUFFER/(OUTBUFFER) /SETUP THE
- DCA PUTPTR /BUFFER POINTER
- PUTLOOP,JMS PUTNEXT /GET A CHARACTER
- DCA I PUTPTR /STORE IT
- TAD PUTPTR /GET POINTER VALUE
- DCA TEMPTR /SAVE FOR LATER
- ISZ PUTPTR /BUMP TO NEXT
- JMS PUTNEXT /GET A CHARACTER
- DCA I PUTPTR /STORE IT
- JMS PUTNEXT /GET A CHARACTER
- RTL;RTL /MOVE UP
- AND [7400] /ISOLATE HIGH NYBBLE
- TAD I TEMPTR /ADD ON FIRST BYTE
- DCA I TEMPTR /STORE COMPOSITE
- TAD LATEST /GET LATEST CHARACTER
- RTR;RTR;RAR /MOVE UP AND
- AND [7400] /ISOLATE LOW NYBBLE
- TAD I PUTPTR /ADD ON SECOND BYTE
- DCA I PUTPTR /STORE COMPOSITE
- ISZ PUTPTR /BUMP TO NEXT
- TAD PUTPTR /GET LATEST POINTER VALUE
- TAD (-2^200-OUTBUFFER) /COMPARE TO LIMIT
- SZA CLA /SKIP IF AT END
- JMP PUTLOOP /KEEP GOING
- ISZ DANGCNT /TOO MANY RECORDS?
- SKP /SKIP IF NOT
- JMP I (SIZERR) /JUMP IF SO
- JMS I OUTPUT /CALL I/O HANDLER
- 2^100+WRITE /WRITE SOME PAGES FROM OUTPUT BUFFER
- POUTBUF,OUTBUFFER /BUFFER ADDRESS
- PUTRECO,.-. /WILL BE LATEST RECORD NUMBER
- JMP I (OERROR) /OUTPUT ERROR!
- ISZ I (OUTCNT) /BUMP ACTUAL LENGTH
- ISZ PUTRECORD /BUMP TO NEXT RECORD
- JMP PUTNEWRECORD /KEEP GOING
- / OS/8 FILE UNPACK ROUTINE.
-
- GETBYTE,.-. /GET A BYTE ROUTINE
- SNA CLA /INITIALIZING?
- JMP I PUTC /NO, GO GET NEXT BYTE
- TAD INRECORD /GET STARTING RECORD OF INPUT FILE
- DCA GETRECORD /STORE IN-LINE
- GETNEWR,JMS I INPUT /CALL I/O HANDLER
- 2^100 /READ TWO PAGES INTO BUFFER
- PINBUFF,INBUFFER /BUFFER ADDRESS
- GETRECO,.-. /WILL BE LATEST RECORD NUMBER
- JMP I GETBERROR /INPUT ERROR!
- TAD PINBUFFER/(INBUFFER) /SETUP THE
- DCA BUFPTR /BUFFER POINTER
- GETLOOP,DCA THIRD /CLEAR THIRD BYTE NOW
- JMS PUTONE /OBTAIN AND SEND BACK FIRST BYTE
- JMS PUTONE /OBTAIN AND SEND BACK SECOND BYTE
- TAD THIRD /GET THIRD BYTE
- JMS PUTC /SEND IT BACK
- TAD BUFPTR /GET THE POINTER
- TAD (-2^200-INBUFFER) /COMPARE TO LIMIT
- SZA CLA /SKIP IF AT END
- JMP GETLOOP /KEEP GOING
- ISZ GETRECORD /BUMP TO NEXT RECORD
- JMP GETNEWRECORD /GO DO ANOTHER ONE
-
- PUTONE, .-. /SEND BACK A BYTE ROUTINE
- TAD I BUFPTR /GET LATEST WORD
- AND [7400] /JUST THIRD-BYTE NYBBLE
- CLL RAL /MOVE UP
- TAD THIRD /GET OLD NYBBLE (IF ANY)
- RTL;RTL /MOVE UP NYBBLE BITS
- DCA THIRD /SAVE FOR NEXT TIME
- TAD I BUFPTR /GET LATEST WORD AGAIN
- JMS PUTC /SEND BACK CURRENT BYTE
- ISZ BUFPTR /BUMP TO NEXT WORD
- JMP I PUTONE /RETURN
-
- PUTC, .-. /SEND BACK LATEST BYTE ROUTINE
- AND (177) /KEEP ONLY GOOD BITS
- DCA PUTEMP /SAVE IT
- TAD PUTEMP /GET IT BACK
- TAD (-"Z!300) /COMPARE TO <^Z>
- SNA CLA /SKIP IF NOT ASCII <EOF>
- JMP I GETBYTE /RETURN IF ASCII MODE <EOF>
- TAD PUTEMP /RESTORE THE CHARACTER
- ISZ GETBYTE /BUMP PAST <EOF> RETURN
- JMP I GETBYTE /RETURN TO MAIN CALLER
- PAGE
- GEOFILE,.-. /GET OUTPUT FILE ROUTINE
- TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
- SZA CLA /SKIP IF NOT ESTABLISHED YET
- JMP GOTOD /JUMP IF DETERMINED ALREADY
- TAD ("D^100+"S-300) /GET BEGINNING OF "DSK"
- DCA DEVNAME /STORE IN-LINE
- TAD ("K^100) /GET REST OF "DSK"
- DCA DEVNAME+1 /STORE IN-LINE
- DCA RETVAL /CLEAR HANDLER ENTRY WORD
- CDF PRGFLD /INDICATE OUR FIELD
- CIF USRFLD /GOTO USR FIELD
- JMS I [USR] /CALL USR ROUTINE
- INQUIRE /INQUIRE ABOUT HANDLER
- DEVNAME,ZBLOCK 2 /WILL BE DEVICE DSK
- RETVAL, .-. /BECOMES HANDLER ENTRY POINT WORD
- HLT /DSK: NOT IN SYSTEM IS IMPOSSIBLE!
- TAD DEVNAME+1 /GET DEVICE NUMBER FOR DSK:
- AND [17] /JUST DEVICE BITS
- DCA ODNUMBER /STORE OUTPUT DEVICE
- GOTOD, JMS SCANAME /SCAN OFF FILE NAME
- CDF TBLFLD /BACK TO TABLE FIELD
- TAD I (OUTFILE+1) /GET OUTPUT FILE FIRST NAME WORD
- SNA /SKIP IF PRESENT
- JMP GFLNAME /JUMP IF NOT
- DCA FNAME /MOVE TO OUR AREA
- TAD I (OUTFILE+2) /GET SECOND NAME WORD
- DCA FNAME+1 /MOVE IT
- TAD I (OUTFILE+3) /GET THIRD NAME WORD
- DCA FNAME+2 /MOVE IT
- TAD I (OUTFILE+4) /GET EXTENSION WORD
- DCA FNAME+3 /MOVE IT
- CDF PRGFLD /BACK TO OUR FIELD
- JMP I GEOFILE /RETURN
-
- / WE MUST TAKE THE FILENAME FROM THE IMBEDDED FILENAME SUPPLIED.
-
- GFLNAME,CDF PRGFLD /BACK TO OUR FIELD
- TAD ONAME /GET THE FIRST CHARACTER
- SNA CLA /SKIP IF SOMETHING THERE
- JMP I (CHARERROR) /COMPLAIN IF NONE THERE
- TAD (ONAME-1) /SETUP POINTER
- DCA XR1 /TO NAME CHARACTERS
- TAD (FNAME-1) /SETUP POINTER
- DCA XR2 /TO PACKED NAME AREA
- TAD (-4) /SETUP THE
- DCA CHRCNT /MOVE COUNT
- CHRLOOP,TAD I XR1 /GET FIRST CHARACTER
- CLL RTL;RTL;RTL /MOVE UP
- TAD I XR1 /ADD ON SECOND CHARACTER
- DCA I XR2 /STORE THE PAIR
- ISZ CHRCNT /DONE YET?
- JMP CHRLOOP /NO, KEEP GOING
- JMP I GEOFILE /YES, RETURN
- SCANAME,.-. /SCAN OFF FILENAME ROUTINE
- TAD (NIOERROR) /SETUP THE
- DCA GETBERROR /I/O ERROR HANDLER
-
- / ZERO OUT THE FILENAME AREA.
-
- TAD (-10) /SETUP THE
- DCA CHRCNT /CLEAR COUNTER
- TAD (ONAME-1) /SETUP THE
- DCA XR1 /POINTER
- JMS CLRNAME /CLEAR THE NAME BUFFER
-
- / SETUP FOR SCANNING THE NAME PORTION.
-
- TAD (-6) /SETUP THE
- DCA CHRCNT /SCAN COUNT
- TAD (ONAME-1) /SETUP THE
- DCA XR1 /POINTER
- NL7777 /MAKE IT INITIALIZE
- FNCAGN, JMS I (GETAN) /GET A CHARACTER
- JMP GOTSEPARATOR /GOT "."; GOTO NEXT FIELD
- DCA I XR1 /STASH THE CHARACTER
- ISZ CHRCNT /DONE ALL YET?
- JMP FNCAGN /NO, KEEP GOING
-
- / THROW AWAY EXTRA NAME CHARACTERS.
-
- TOSSNAM,JMS I (GETAN) /GET A CHARACTER
- JMP GOTSEPARATOR /GOT "."; GOTO NEXT FIELD
- CLA /THROW AWAY THE CHARACTER
- JMP TOSSNAME /KEEP GOING
-
- / COMES HERE AFTER "." FOUND.
-
- GOTSEPA,JMS CLRNAME /CLEAR OUT THE REMAINING NAME FIELD
- NL7776 /SETUP THE
- DCA CHRCNT /SCAN COUNT
- EXCAGN, JMS I (GETAN) /GET A CHARACTER
- JMP I (CHARERROR) /GOT "."; COMPLAIN
- DCA I XR1 /STASH THE CHARACTER
- ISZ CHRCNT /DONE ENOUGH YET?
- JMP EXCAGN /NO, KEEP GOING
-
- / TOSS ANY EXTRA EXTENSION CHARACTERS.
-
- TOSSEXT,JMS I (GETAN) /GET A CHARACTER
- JMP I (CHARERROR) /GOT "."; COMPLAIN
- CLA /THROW AWAY THE CHARACTER
- JMP TOSSEXTENSION /KEEP GOING
-
- / COMES HERE WHEN TRAILING <CR> IS FOUND.
-
- GOTCR, JMS CLRNAME /CLEAR ANY REMAINING EXTENSION CHARACTERS
- JMP I SCANAME /RETURN
- CLRNAME,.-. /NAME FIELD CLEARING ROUTINE
- TAD CHRCNT /GET CHARACTER COUNTER
- SNA CLA /SKIP IF ANY TO CLEAR
- JMP I CLRNAME /ELSE JUST RETURN
- DCA I XR1 /CLEAR A NAME WORD
- ISZ CHRCNT /COUNT IT
- JMP .-2 /KEEP GOING
- JMP I CLRNAME /RETURN
-
- PAGE
- GETCHAR,.-. /GET A CHARACTER ROUTINE
- JMS I [GETBYTE] /GET A CHARACTER
- JMP I (CHARERROR) /COMPLAIN IF <EOF> REACHED
- TAD (-"M!300) /COMPARE TO <CR>
- SNA /SKIP IF OTHER
- JMP I (GOTCR) /JUMP IF IT MATCHES
- TAD (-140+"M-300) /COMPARE TO LOWER-CASE LIMIT
- SPA /SKIP IF LOWER-CASE
- TAD (40) /RESTORE ORIGINAL IF UPPER-CASE
- AND (77) /JUST SIX-BIT
- DCA PUTEMP /SAVE IN CASE WE NEED IT
- TAD PUTEMP /GET IT BACK
- JMP I GETCHAR /RETURN
-
- GETAN, .-. /GET ALPHANUMERIC ROUTINE
- GETNAGN,JMS GETCHAR /GET A CHARACTER
- TAD [-" !200] /COMPARE TO <SPACE>
- SNA CLA /SKIP IF OTHER
- JMP GETNAGN /JUMP IF IT MATCHES
- TAD PUTEMP /GET THE CHARACTER BACK
- TAD (-".!200) /COMPARE TO "."
- SNA /SKIP IF OTHER
- JMP I GETAN /TAKE FIRST RETURN IF IT MATCHES
- TAD (-":+".) /SUBTRACT UPPER LIMIT
- CLL /CLEAR LINK FOR TEST
- TAD (":-"0) /ADD ON RANGE
- SZL CLA /SKIP IF NOT NUMERIC
- JMP GETANOK /JUMP IF NUMERIC
- TAD PUTEMP /GET THE CHARACTER BACK
- TAD (-"[!300) /SUBTRACT UPPER LIMIT
- CLL /CLEAR LINK FOR TEST
- TAD ("[-"A) /ADD ON RANGE
- SNL CLA /SKIP IF ALPHABETIC
- JMP I (CHARERROR) /ELSE COMPLAIN
- GETANOK,TAD PUTEMP /GET GOOD ALPHANUMERIC CHARACTER
- ISZ GETAN /BUMP TO SKIP RETURN
- JMP I GETAN /RETURN
-
- PAGE
- $ /THAT'S ALL FOLK!
-